home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / scm / xscm.lha / xscm / xt.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-08-29  |  30.0 KB  |  1,269 lines
  1. /*
  2.  * $Header: /home/campbell/Languages/Scheme/scm/x-scm/RCS/xt.c,v 1.15 1992/08/17 04:06:02 campbell Beta $
  3.  *
  4.  * Author: Larry Campbell (campbell@redsox.bsw.com)
  5.  *
  6.  * Copyright 1992 by The Boston Software Works, Inc.
  7.  * Permission to use for any purpose whatsoever granted, as long
  8.  * as this copyright notice remains intact.  Please send bug fixes
  9.  * or enhancements to the above email address.
  10.  *
  11.  * X Toolkit interface for scm
  12.  */
  13.  
  14. #include <stdio.h>
  15. #include <X11/Intrinsic.h>
  16. #include <X11/StringDefs.h>
  17. #include <X11/IntrinsicP.h>
  18. #include <X11/Core.h>
  19. #include <X11/CoreP.h>
  20. #include <X11/Shell.h>
  21.  
  22. #ifdef MOTIF
  23. #include <Xm/Xm.h>
  24. #endif
  25.  
  26. #include "scm.h"
  27. #include "x.h"
  28. #include "xt.h"
  29.  
  30. static char s_xt_add_callback[]            = "xt:add-callback";
  31. static char s_xt_add_event_handler[]        = "xt:add-event-handler";
  32. static char s_xt_add_time_out[]            = "xt:add-time-out";
  33. static char s_xt_add_work_proc[]        = "xt:add-work-proc";
  34. static char s_xt_app_create_shell[]        = "xt:app-create-shell";
  35. static char s_xt_class[]            = "xt:class";
  36. static char s_xt_class_name[]            = "xt:class-name";
  37. static char s_xt_class_subclassp[]        = "xt:class-subclass?";
  38. static char s_xt_class_superclass[]        = "xt:class-superclass";
  39. static char s_xt_create_managed_widget[]    = "xt:create-managed-widget";
  40. static char s_xt_create_popup_shell[]        = "xt:create-popup-shell";
  41. static char s_xt_create_widget[]        = "xt:create-widget";
  42. static char s_xt_destroy_widget[]        = "xt:destroy-widget";
  43. static char s_xt_dispatch_event[]        = "xt:dispatch-event";
  44. static char s_xt_display[]            = "xt:display";
  45.  
  46. /* identifier truncated to 31 characters to shut certain C compilers up */
  47. static char s_xt_get_constraint_resource_li[]    = "xt:get-constraint-resource-list";
  48.  
  49. static char s_xt_get_resource_list[]        = "xt:get-resource-list";
  50. static char s_xt_get_value[]            = "xt:get-value";
  51. static char s_xt_initialize[]            = "xt:initialize";
  52. static char s_xt_is_realized[]            = "xt:is-realized";
  53. static char s_xt_main_loop[]            = "xt:main-loop";
  54. static char s_xt_manage_children[]        = "xt:manage-children";
  55. static char s_xt_map_widget[]            = "xt:map-widget";
  56. static char s_xt_move_widget[]            = "xt:move-widget";
  57. static char s_xt_name[]                = "xt:name";
  58. static char s_xt_next_event[]            = "xt:next-event";
  59. static char s_xt_parent[]            = "xt:parent";
  60. static char s_xt_popdown[]            = "xt:popdown";
  61. static char s_xt_popup[]            = "xt:popup";
  62. static char s_xt_realize_widget[]        = "xt:realize-widget";
  63. static char s_xt_remove_event_handler[]        = "xt:remove-event-handler";
  64. static char s_xt_remove_time_out[]        = "xt:remove-time-out";
  65. static char s_xt_remove_work_proc[]        = "xt:remove-work-proc";
  66. static char s_xt_set_sensitive[]        = "xt:set-sensitive";
  67. static char s_xt_set_values[]            = "xt:set-values";
  68. static char s_xt_subclassp[]            = "xt:subclass?";
  69. static char s_xt_superclass[]            = "xt:superclass";
  70. static char s_xt_unmanage_children[]        = "xt:unmanage-children";
  71. static char s_xt_unmap_widget[]            = "xt:unmap-widget";
  72. static char s_xt_unrealize_widget[]        = "xt:unrealize-widget";
  73. static char s_xt_window[]            = "xt:window";
  74.  
  75. static char s_xt_widget_class_map[]        = "*widget-class-map*";
  76.  
  77. static SCM *loc_class_map;
  78.  
  79. /* forward declarations */
  80. void xt__make_arglist();
  81. static SCM xt__make_resource_list();
  82.  
  83. xt_widget_class_t xt_widget_classes[] = {
  84.     "xt:application-shell",    &applicationShellWidgetClass,
  85.     "xt:composite",        &compositeWidgetClass,
  86.     "xt:constraint",        &constraintWidgetClass,
  87.     "xt:core",            &coreWidgetClass,
  88.     "xt:override-shell",    &overrideShellWidgetClass,
  89.     "xt:shell",            &shellWidgetClass,
  90.     "xt:top-level-shell",    &topLevelShellWidgetClass,
  91.     "xt:transient-shell",    &transientShellWidgetClass,
  92.     "xt:wm-shell",        &wmShellWidgetClass
  93. };
  94.  
  95. #define MAKFROMSTR(s) (makfromstr(s, strlen(s)))
  96.  
  97. static SCM xt__class_equalp();
  98. static SCM xt__widget_equalp();
  99.  
  100. /*
  101.  * Scheme types defined in this module
  102.  */
  103.  
  104. #define XT_SMOBS                              \
  105. XX(widget,        mark_no_further,    free0, xt__widget_equalp) \
  106. XX(widget_class,    mark_no_further,    free0, xt__class_equalp)
  107.  
  108. #undef XX
  109. #define XX(name, mark, free, equalp)        \
  110. long TOKEN_PASTE(tc16_,name);            \
  111. static int TOKEN_PASTE(print_,name)();        \
  112. static smobfuns TOKEN_PASTE(smob,name) =    \
  113.     { mark, free, TOKEN_PASTE(print_,name), equalp };
  114.  
  115. XT_SMOBS
  116.  
  117.  
  118. SCM make_widget(w)
  119. {
  120.   SCM sw;
  121.   NEWCELL(sw);
  122.   DEFER_INTS;
  123.   CAR(sw) = tc16_widget;
  124.   SETCDR(sw,w);
  125.   ALLOW_INTS;
  126.   return sw;
  127. }
  128.  
  129. SCM make_widget_class(c)
  130. WidgetClass c;
  131. {
  132.   SCM w;
  133.   NEWCELL(w);
  134.   DEFER_INTS;
  135.   CAR(w) = tc16_widget_class;
  136.   SETCDR(w, c);
  137.   ALLOW_INTS;
  138.   return w;
  139. }
  140.  
  141. static SCM xt__class_equalp(x, y)
  142. SCM x, y;
  143. {
  144.   if (CDR(x) == CDR(y))
  145.     return BOOL_T;
  146.   else
  147.     return BOOL_F;
  148. }
  149.  
  150. static SCM xt__widget_equalp(x, y)
  151. SCM x, y;
  152. {
  153.   if (CDR(x) == CDR(y))
  154.     return BOOL_T;
  155.   else
  156.     return BOOL_F;
  157. }
  158.  
  159.  
  160. static SCM *loc_callbacks;
  161.  
  162. static void protect_callback(proc)
  163. SCM proc;
  164. {
  165.   if (memq(proc, *loc_callbacks) != BOOL_F)
  166.     return;
  167.   *loc_callbacks = cons(proc, *loc_callbacks);
  168. }
  169.  
  170.  
  171. SCM xt_destroy_widget(sw)
  172. SCM sw;
  173. {
  174.   ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xt_map_widget);
  175.   XtDestroyWidget(WIDGET(sw));
  176.   return UNSPECIFIED;
  177. }
  178.  
  179. SCM xt_initialize(sname, sclass, args)
  180. SCM sname, sclass, args;
  181. {
  182.   Widget top_level;
  183.   char *argv[1];
  184.   int argc;
  185.  
  186.   ASSERT(NIMP(sname) && STRINGP(sname), args, ARG1, s_xt_initialize);
  187.   ASSERT(NIMP(sclass) && STRINGP(sclass), args, ARG2, s_xt_initialize);
  188.  
  189.   argv[0] = CHARS(sname);
  190.   argc = 1;
  191.   top_level = XtInitialize(CHARS(sname), CHARS(sclass), 0, 0, &argc, argv);
  192.  
  193.   ASSERT(top_level != 0, sname, "XtInitialize error", s_xt_initialize);
  194.  
  195.   return make_widget(top_level);
  196. }
  197.  
  198.  
  199. SCM xt_app_create_shell(sname, sclass, args)
  200. SCM sname, sclass, args;
  201. {
  202.   Widget shell;
  203.   SCM swc;
  204.   SCM sdisplay;
  205.   Display *display;
  206.   char *argv[1];
  207.   int argc;
  208.  
  209.   ASSERT(NIMP(sname) && STRINGP(sname), args, ARG1, s_xt_app_create_shell);
  210.   ASSERT(NIMP(sclass) && STRINGP(sclass), args, ARG2, s_xt_app_create_shell);
  211.   ASSERT(NIMP(args) && CONSP(args), args, ARG3, s_xt_app_create_shell);
  212.   swc = CAR(args);
  213.   args = CDR(args);
  214.   ASSERT(NIMP(swc) && WIDGETCLASSP(swc), swc, ARG3, s_xt_app_create_shell);
  215.   ASSERT(NIMP(args) && CONSP(args), args, ARG3, s_xt_app_create_shell);
  216.   sdisplay = CAR(args);
  217.   ASSERT(NIMP(sdisplay) && XDISPLAYP(sdisplay), sdisplay,  ARG4, s_xt_app_create_shell);
  218.   display = (Display *) CDR(sdisplay);
  219.   argv[0] = CHARS(sname);
  220.   argc = 1;
  221.   shell = XtAppCreateShell(
  222.     CHARS(sname),
  223.     CHARS(sclass),
  224.     WIDGETCLASS(swc),
  225.     display,
  226.     0,
  227.     0);
  228.  
  229.   ASSERT(shell != 0, sname, "XtAppCreateShell error", s_xt_app_create_shell);
  230.  
  231.   return make_widget(shell);
  232. }
  233.  
  234.  
  235. SCM xt_class(sw)
  236. SCM sw;
  237. {
  238.   ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xt_class);
  239.   return make_widget_class(XtClass(WIDGET(sw)));
  240. }
  241.  
  242.  
  243. SCM xt_class_name(swc)
  244. SCM swc;
  245. {
  246.   char *p;
  247.   ASSERT(NIMP(swc) && WIDGETCLASSP(swc), swc, ARG1, s_xt_class_name);
  248.   p = WIDGETCLASS(swc)->core_class.class_name;
  249.   return MAKFROMSTR(p);
  250. }
  251.  
  252.  
  253. static Boolean xt_work_proc_handler(proc)
  254. SCM proc;
  255. {
  256.   SCM result = apply(proc, EOL, EOL);
  257.   if (result != BOOL_F && result != BOOL_T) {
  258.     fprintf(stderr, "warning: procedure registered by xt:add-work-proc must return #t or #f\n");
  259.     result = BOOL_T;
  260.   }
  261.   return (result == BOOL_T);
  262. }
  263.  
  264.  
  265. SCM xt_add_work_proc(proc)
  266. SCM proc;
  267. {
  268.   ASSERT(NIMP(proc) && CLOSUREP(proc), proc, ARG1, s_xt_add_work_proc);
  269.   return MAKINUM(XtAddWorkProc(xt_work_proc_handler, proc));
  270. }
  271.  
  272.  
  273. static void xt_time_out_handler(proc)
  274. SCM proc;
  275. {
  276.   (void) apply(proc, EOL, EOL);
  277. }
  278.  
  279.  
  280. SCM xt_add_time_out(interval, proc)
  281. SCM interval, proc;
  282. {
  283.   ASSERT(INUMP(interval) && INUM(interval) > 0, interval, ARG1, s_xt_add_time_out);
  284.   ASSERT(NIMP(proc) && CLOSUREP(proc), proc, ARG2, s_xt_add_time_out);
  285.   return MAKINUM(XtAddTimeOut(INUM(interval), xt_time_out_handler, proc));
  286. }
  287.  
  288.  
  289. SCM xt_remove_time_out(id)
  290. SCM id;
  291. {
  292.   ASSERT(INUMP(id), id, ARG1, s_xt_remove_time_out);
  293.   XtRemoveTimeOut(INUM(id));
  294.   return UNSPECIFIED;
  295. }
  296.  
  297.  
  298. SCM xt_remove_work_proc(id)
  299. SCM id;
  300. {
  301.   ASSERT(INUMP(id), id, ARG1, s_xt_remove_work_proc);
  302.   XtRemoveWorkProc(INUM(id));
  303.   return UNSPECIFIED;
  304. }
  305.  
  306.  
  307. /* This routine implements XtCreate(Managed)Widget */
  308.  
  309. static SCM xt__create_a_widget(sname, sclass, args, rtn, name)
  310. SCM sname, sclass, args;
  311. Widget (rtn)();
  312. char *name;
  313. {
  314.   SCM sparent;
  315.   Widget parent;
  316.   Widget w;
  317.   Arg *arglist;
  318.   int n;
  319.  
  320.   ASSERT(NIMP(sname) && STRINGP(sname), sname, ARG1, name);
  321.   ASSERT(NIMP(sclass) && WIDGETCLASSP(sclass), sclass, ARG2, name);
  322.   ASSERT(NIMP(args) && CONSP(args), args, ARG3, name);
  323.   sparent = CAR(args); args = CDR(args);
  324.   ASSERT(NIMP(sparent) && WIDGETP(sparent), sparent, ARG3, name);
  325.  
  326.   xt__make_arglist(args, &arglist, &n, name);
  327.  
  328.   w = rtn(CHARS(sname), CHARS(sclass), WIDGET(sparent), arglist, n);
  329.  
  330.   if (arglist) free(arglist);
  331.  
  332.   return make_widget(w);
  333. }
  334.  
  335.  
  336. SCM xt_create_managed_widget(sname, sclass, args)
  337. SCM sname, sclass, args;
  338. {
  339.   return xt__create_a_widget(
  340.     sname, sclass, args, XtCreateManagedWidget, s_xt_create_managed_widget);
  341. }
  342.  
  343.  
  344. SCM xt_create_widget(sname, sclass, args)
  345. SCM sname, sclass, args;
  346. {
  347.   return xt__create_a_widget(
  348.     sname, sclass, args, XtCreateWidget, s_xt_create_widget);
  349. }
  350.  
  351.  
  352. SCM xt_create_popup_shell(sname, sclass, args)
  353. SCM sname, sclass, args;
  354. {
  355.   SCM sparent;
  356.   Widget parent;
  357.   Widget w;
  358.   Arg *arglist;
  359.   int n;
  360.  
  361.   ASSERT(NIMP(sname) && STRINGP(sname), sname, ARG1, s_xt_create_popup_shell);
  362.   ASSERT(NIMP(sclass) && WIDGETCLASSP(sclass), sclass, ARG2, s_xt_create_popup_shell);
  363.   ASSERT(NIMP(args) && CONSP(args), args, ARG3, s_xt_create_popup_shell);
  364.   sparent = CAR(args); args = CDR(args);
  365.   ASSERT(NIMP(sparent) && WIDGETP(sparent), sparent, ARG4, s_xt_create_popup_shell);
  366.  
  367.   xt__make_arglist(args, &arglist, &n, s_xt_create_popup_shell);
  368.  
  369.   w = XtCreatePopupShell(CHARS(sname), CHARS(sclass), WIDGET(sparent), arglist, n);
  370.  
  371.   if (arglist) free(arglist);
  372.  
  373.   return make_widget(w);
  374. }
  375.  
  376.  
  377. SCM xt_move_widget(sw, sx, sy)
  378. SCM sw, sx, sy;
  379. {
  380.   ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xt_move_widget);
  381.   ASSERT(INUMP(sx), sx, ARG2, s_xt_move_widget);
  382.   ASSERT(INUMP(sy), sy, ARG3, s_xt_move_widget);
  383.   XtMoveWidget(WIDGET(sw), INUM(sx), INUM(sy));
  384.   return UNSPECIFIED;
  385. }
  386.  
  387.  
  388. SCM xt_map_widget(sw)
  389. SCM sw;
  390. {
  391.   ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xt_map_widget);
  392.   XtMapWidget(WIDGET(sw));
  393.   return UNSPECIFIED;
  394. }
  395.  
  396.  
  397. static void xt__make_widget_list(wlp, np, args, name)
  398. WidgetList *wlp;
  399. int *np;
  400. SCM args;
  401. char *name;
  402. {
  403.   int i, n;
  404.   SCM sw;
  405.  
  406.   ASSERT(NIMP(args) && CONSP(args), args, ARG1, name);
  407.   n = ilength(args);
  408.   *np = n;
  409.   if (!n) return;
  410.   *wlp = (WidgetList) must_malloc(n * sizeof(Widget), name);
  411.   for (i = 0; i < n; i++) {
  412.     ASSERT(NIMP(args) && CONSP(args), args, "improper arg list", name);
  413.     sw = CAR(args);
  414.     args = CDR(args);
  415.     ASSERT(NIMP(sw) && WIDGETP(sw), sw, "must be a widget", name);
  416.     (*wlp)[i] = WIDGET(sw);
  417.   }
  418. }
  419.  
  420.  
  421. SCM xt_manage_children(args)
  422. SCM args;
  423. {
  424.   WidgetList wl;
  425.   int n;
  426.   xt__make_widget_list(&wl, &n, args, s_xt_manage_children);
  427.   if (n)
  428.     XtManageChildren(wl, n);
  429.   return UNSPECIFIED;
  430. }
  431.  
  432.  
  433. /*
  434.  * The standard X Toolkit functions XtIsSubclass and XtSuperclass
  435.  * stupidly take widgets, not classes, making them useless for walking
  436.  * up the class hierarchy.  I was tempted to make xt:subclass? and
  437.  * xt:superclass do the right thing, but decided it might confuse people
  438.  * used to the original functions, so instead I called the useful
  439.  * functions xt:class-subclass? and xt:class-superclass.
  440.  */
  441.  
  442. SCM xt_subclassp(sw, swc)
  443. SCM sw;
  444. SCM swc;
  445. {
  446.   ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xt_subclassp);
  447.   ASSERT(NIMP(swc) && WIDGETCLASSP(swc), swc, ARG1, s_xt_subclassp);
  448.  
  449.   if (XtIsSubclass(WIDGET(sw), WIDGETCLASS(swc)))
  450.     return BOOL_T;
  451.   else
  452.     return BOOL_F;
  453. }
  454.  
  455. SCM xt_class_subclassp(swt, swc)
  456. SCM swt;
  457. SCM swc;
  458. {
  459.   WidgetClass x, c;
  460.  
  461.   ASSERT(NIMP(swt) && WIDGETCLASSP(swt), swt, ARG1, s_xt_class_subclassp);
  462.   ASSERT(NIMP(swc) && WIDGETCLASSP(swc), swc, ARG1, s_xt_class_subclassp);
  463.   c = WIDGETCLASS(swc);
  464.  
  465.   for (x = WIDGETCLASS(swt); x; x = x->core_class.superclass) {
  466.     if (x == c)
  467.       return BOOL_T;
  468.   }
  469.   return BOOL_F;
  470. }
  471.  
  472.  
  473. SCM xt_superclass(sw)
  474. SCM sw;
  475. {
  476.   ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xt_superclass);
  477.   return make_widget_class(XtSuperclass(WIDGET(sw)));
  478. }
  479.  
  480.  
  481. SCM xt_class_superclass(scw)
  482. SCM scw;
  483. {
  484.   ASSERT(NIMP(scw) && WIDGETCLASSP(scw), scw, ARG1, s_xt_class_superclass);
  485.   return make_widget_class(WIDGETCLASS(scw)->core_class.superclass);
  486. }
  487.  
  488.  
  489. SCM xt_unmanage_children(args)
  490. SCM args;
  491. {
  492.   WidgetList wl;
  493.   int n;
  494.   xt__make_widget_list(&wl, &n, args, s_xt_unmanage_children);
  495.   if (n)
  496.     XtUnmanageChildren(wl, n);
  497.   return UNSPECIFIED;
  498. }
  499.  
  500.  
  501. SCM xt_unmap_widget(sw)
  502. SCM sw;
  503. {
  504.   ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xt_unmap_widget);
  505.   XtUnmapWidget(WIDGET(sw));
  506.   return UNSPECIFIED;
  507. }
  508.  
  509.  
  510. SCM xt_unrealize_widget(sw)
  511. SCM sw;
  512. {
  513.   ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xt_unrealize_widget);
  514.   XtUnrealizeWidget(WIDGET(sw));
  515.   return UNSPECIFIED;
  516. }
  517.  
  518.  
  519. SCM xt_name(sw)
  520. SCM sw;
  521. {
  522.   ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xt_name);
  523.   return MAKFROMSTR(XtName(WIDGET(sw)));
  524. }
  525.  
  526.  
  527. SCM xt_parent(sw)
  528. SCM sw;
  529. {
  530.   Widget parent;
  531.   ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xt_parent);
  532.   parent = XtParent(WIDGET(sw));
  533.   if (parent)
  534.     return make_widget(parent);
  535.   else
  536.     return BOOL_F;
  537. }
  538.  
  539.  
  540. SCM xt_popdown(sw)
  541. SCM sw;
  542. {
  543.   ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xt_popdown);
  544.   XtPopdown(WIDGET(sw));
  545.   return UNSPECIFIED;
  546. }
  547.  
  548. SCM xt_popup(sw, sgrab)
  549. SCM sw, sgrab;
  550. {
  551.   ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xt_popup);
  552.   ASSERT(INUMP(sgrab), sgrab, ARG2, s_xt_popup);
  553.   XtPopup(WIDGET(sw), INUM(sgrab));
  554.   return UNSPECIFIED;
  555. }
  556.  
  557. void xt__make_arglist(args, arglistp, np, caller_name)
  558. SCM    args;
  559. Arg **arglistp;
  560. int   *np;
  561. char  *caller_name;
  562. {
  563.   Arg *arglist;
  564.   int l, n;
  565.   SCM sname, svalue;
  566.   char *name;
  567.   XtArgVal value;
  568.  
  569.   l = ilength(args) / 2;
  570.   arglist = 0;
  571.   n = 0;
  572.   if (l > 0) {
  573.     arglist = (Arg *) must_malloc(l * sizeof(Arg), caller_name);
  574.     for (n = 0; n < l; n++) {
  575.       ASSERT(NIMP(args) && CONSP(args), args, ARG1, caller_name);
  576.       sname = CAR(args); args = CDR(args);
  577.       ASSERT(NIMP(args) && CONSP(args), args, ARG1, caller_name);
  578.       svalue = CAR(args); args = CDR(args);
  579.       ASSERT(NIMP(sname) && STRINGP(sname), sname, ARG1, caller_name);
  580.       name = CHARS(sname);
  581.  
  582.       if (svalue == BOOL_F)
  583.     value = (XtArgVal) FALSE;
  584.       else if (svalue == BOOL_T)
  585.     value = (XtArgVal) TRUE;
  586.       else
  587. #ifdef MOTIF
  588.       if (NIMP(svalue) && (XMSTRINGP(svalue) || XMSTRINGTABLEP(svalue)))
  589.     value = (XtArgVal) XMSTRING(svalue);
  590.       else
  591. #endif
  592.       if (NIMP(svalue) && (STRINGP(svalue) || WIDGETP(svalue)))
  593.     value = (XtArgVal) CHARS(svalue);
  594.       else if (INUMP(svalue))
  595.     value = (XtArgVal) INUM(svalue);
  596.       else
  597.         ASSERT(0, svalue, "invalid resource type", caller_name);
  598.  
  599.       XtSetArg(arglist[n], name, value);
  600.     }
  601.   }
  602.   *arglistp = arglist;
  603.   *np = n;
  604. }
  605.  
  606.  
  607. SCM xt_realize_widget(sw)
  608. SCM sw;
  609. {
  610.   ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xt_realize_widget);
  611.   XtRealizeWidget(WIDGET(sw));
  612.   return UNSPECIFIED;
  613. }
  614.  
  615.  
  616. SCM xt_dispatch_event(se)
  617. SCM se;
  618. {
  619.   ASSERT(NIMP(se) && XEVENTP(se), se, ARG1, s_xt_dispatch_event);
  620.   return XtDispatchEvent(XEVENT(se)) ? BOOL_T : BOOL_F;
  621. }
  622.  
  623.  
  624. SCM xt_display(sw)
  625. SCM sw;
  626. {
  627.   SCM sd;
  628.  
  629.   ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xt_display);
  630.   sw = make_xdisplay(XtDisplay(WIDGET(sw)));
  631.   return sw;
  632. }
  633.  
  634.  
  635. SCM xt_window(sw)
  636. SCM sw;
  637. {
  638.   Widget widget;
  639.  
  640.   ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xt_window);
  641.   widget = WIDGET(sw);
  642.   ASSERT(XtIsRealized(widget), sw, "widget is not realized", s_xt_window);
  643.   sw = make_xwindow(XtWindow(widget));
  644.   return sw;
  645. }
  646.  
  647. SCM xt_is_realized(sw)
  648. SCM sw;
  649. {
  650.   ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xt_is_realized);
  651.   return XtIsRealized(WIDGET(sw)) ? BOOL_T : BOOL_F;
  652. }
  653.  
  654.  
  655. /*
  656.  * Temporary kludge: Xt keels over pretty rapidly if you call
  657.  * XtMainLoop recursively (i.e., from a callback or event handler).
  658.  * We need to prevent this, but also need to allow XtMainLoop to
  659.  * be reentered if we get thrown out because an error occurred.
  660.  * Doing this properly requires cooperation with scm's top level,
  661.  * but I don't have time to do that right now.  So, this hack:
  662.  * xt:main-loop should ordinarily be called with no arguments, but
  663.  * if you call it with the single argument #t, it will bypass the
  664.  * recursion check.
  665.  */
  666.  
  667. SCM xt_main_loop(args)
  668. {
  669.   static Bool running;
  670.   if (NIMP(args) && CONSP(args) && (CAR(args) == BOOL_T))
  671.     running = FALSE;
  672.   ASSERT(!running, UNDEFINED, "xt:main-loop already running", s_xt_main_loop);
  673.   running = TRUE;
  674.   XtMainLoop();
  675.   return UNSPECIFIED;
  676. }
  677.  
  678. void xt_event_handler(w, proc, event, continue_to_dispatch)
  679. Widget w;
  680. XtPointer proc;
  681. XEvent *event;
  682. Boolean *continue_to_dispatch;
  683. {
  684.   SCM sproc = (SCM) proc;
  685.   SCM se, sw, args;
  686.  
  687.   se = make_xevent(event);
  688.   sw = make_widget(w);
  689.   args = cons(se, EOL);
  690.   args = cons(args, EOL);
  691.   
  692.   apply(proc, sw, args);
  693. }
  694.  
  695.  
  696. SCM xt_add_event_handler(sw, smask, args)
  697. SCM sw, smask, args;
  698. {
  699.   SCM snonmaskable;
  700.   SCM proc;
  701.  
  702.   ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xt_add_event_handler);
  703.   ASSERT(INUMP(smask), smask, ARG2, s_xt_add_event_handler);
  704.   ASSERT(NIMP(args) && CONSP(args), args, ARG3, s_xt_add_event_handler);
  705.   snonmaskable = CAR(args); args = CDR(args);
  706.   ASSERT(INUMP(snonmaskable), snonmaskable, ARG4, s_xt_add_event_handler);
  707.   ASSERT(NIMP(args) && CONSP(args), args, ARG5, s_xt_add_event_handler);
  708.   proc = CAR(args);
  709.  
  710.   protect_callback(proc);
  711.  
  712.   XtAddEventHandler(WIDGET(sw), INUM(smask), INUM(snonmaskable), xt_event_handler, proc);
  713.  
  714.   return UNSPECIFIED;
  715. }
  716.  
  717.  
  718. static void xt_callback_handler(w, proc, data)
  719. Widget w;
  720. XtPointer proc, data;
  721. {
  722.   SCM sw;
  723.   SCM sproc = (SCM) proc;
  724.  
  725.   sw = make_widget(w);
  726.   apply(proc, sw, listofnull);
  727. }
  728.  
  729.  
  730. SCM xt_remove_event_handler(sw, smask, args)
  731. SCM sw, smask, args;
  732. {
  733.   SCM snonmaskable;
  734.   SCM proc;
  735.  
  736.   ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xt_remove_event_handler);
  737.   ASSERT(INUMP(smask), smask, ARG2, s_xt_remove_event_handler);
  738.   ASSERT(NIMP(args) && CONSP(args), args, ARG3, s_xt_remove_event_handler);
  739.   snonmaskable = CAR(args); args = CDR(args);
  740.   ASSERT(INUMP(snonmaskable), snonmaskable, ARG4, s_xt_remove_event_handler);
  741.   ASSERT(NIMP(args) && CONSP(args), args, ARG5, s_xt_remove_event_handler);
  742.   proc = CAR(args);
  743.  
  744.   XtRemoveEventHandler(WIDGET(sw), INUM(smask), INUM(snonmaskable), xt_event_handler, proc);
  745.  
  746.   return UNSPECIFIED;
  747. }
  748.  
  749.  
  750. SCM xt_add_callback(sw, sname, args)
  751. SCM sw, sname, args;
  752. {
  753.   SCM proc;
  754.  
  755.   ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xt_add_callback);
  756.   ASSERT(NIMP(sname) && STRINGP(sname), sname, ARG2, s_xt_add_callback);
  757.   ASSERT(NIMP(args) && CONSP(args), args, "consp", s_xt_add_callback);
  758.   proc = CAR(args);
  759.   ASSERT(NIMP(proc) && CLOSUREP(proc), proc, "closurep", s_xt_add_callback);
  760.  
  761.   protect_callback(proc);
  762.  
  763.   XtAddCallback(WIDGET(sw), CHARS(sname), xt_callback_handler, proc);
  764.  
  765.   return UNSPECIFIED;
  766. }
  767.  
  768.  
  769. static SCM xt__make_resource_object(p, type)
  770. char *p, *type;
  771. {
  772.   SCM s;
  773.  
  774.   if (!p)
  775.     return EOL;
  776.   if (strcmp(type, "Boolean") == 0)
  777.     return (*((Boolean *) p)) ? BOOL_T : BOOL_F;
  778.   if ( (strcmp(type, "Int") == 0) ||
  779.        (strcmp(type, "VerticalInt") == 0) ||
  780.        (strcmp(type, "HorizontalInt") == 0)
  781.      )
  782.     return MAKINUM(*((int *) p));
  783.   if ( (strcmp(type, "Short") == 0) ||
  784.        (strcmp(type, "VerticalDimension") == 0) ||
  785.        (strcmp(type, "HorizontalDimension") == 0) ||
  786.        (strcmp(type, "VerticalPosition") == 0) ||
  787.        (strcmp(type, "HorizontalPosition") == 0)
  788.      )
  789.     return MAKINUM(*((short *) p));
  790.   if (strcmp(type, "String") == 0)
  791.     return MAKFROMSTR(p);
  792. #ifdef MOTIF
  793.   if (strcmp(type, "XmString") == 0) {
  794.     s = make_xmstring();
  795.     SETCDR(s, XmStringCreateLtoR(CHARS(p), XmSTRING_DEFAULT_CHARSET));
  796.     return s;
  797.   }
  798. #endif
  799.   return EOL;
  800. }
  801.  
  802.  
  803. SCM xt_get_resource_list(swc)
  804. SCM swc;
  805. {
  806.   XtResourceList resources;
  807.   Cardinal n;
  808.   SCM result;
  809.  
  810.   ASSERT(NIMP(swc) && WIDGETCLASSP(swc), swc, ARG1, s_xt_get_resource_list);
  811.   XtGetResourceList(WIDGETCLASS(swc), &resources, &n);
  812.   result = xt__make_resource_list(resources, n);
  813.   XtFree(resources);
  814.   return result;
  815. }
  816.  
  817. SCM xt_get_constraint_resource_list(swc)
  818. SCM swc;
  819. {
  820.   XtResourceList resources;
  821.   Cardinal n;
  822.   SCM result;
  823.  
  824.   ASSERT(NIMP(swc) && WIDGETCLASSP(swc), swc, ARG1, s_xt_get_constraint_resource_li);
  825.   XtGetConstraintResourceList(WIDGETCLASS(swc), &resources, &n);
  826.   result = xt__make_resource_list(resources, n);
  827.   XtFree(resources);
  828.   return result;
  829. }
  830.  
  831.  
  832. /*
  833.  * This routine stinks, but so does the X Toolkit's handling of resource
  834.  * data types.  This code will only work on machines that are reasonably
  835.  * VAX-like.  If you fix it, please send me the improved code!
  836.  */
  837.  
  838. static SCM xt__make_resource_list(resources, n)
  839. XtResourceList resources;
  840. Cardinal n;
  841. {
  842.   Cardinal i;
  843.   int size, x;
  844.   SCM result, item, name, class, stype, ssize, sdeftype, defvalue;
  845.   char *p, *type, *deftype;
  846.  
  847.   if (n == 0)
  848.     return EOL;
  849.   result = EOL;
  850.   for (i = 0; i < n; i++) {
  851.     name  = MAKFROMSTR(resources[i].resource_name);
  852.     class = MAKFROMSTR(resources[i].resource_class);
  853.     type = resources[i].resource_type;
  854.     stype  = MAKFROMSTR(type);
  855.     size = resources[i].resource_size;
  856.     ssize  = MAKINUM(size);
  857.     deftype = resources[i].default_type;
  858.     sdeftype = MAKFROMSTR(deftype);
  859.     if (strcmp(deftype, "Immediate") == 0) {
  860.       p = (char *) &resources[i].default_addr;
  861.       deftype = type;
  862.     } else
  863.       p = resources[i].default_addr;
  864.     defvalue = xt__make_resource_object(p, deftype);
  865.     item  = cons(name, cons(class, cons(stype, cons(ssize, cons(sdeftype, cons(defvalue, EOL))))));
  866.     result = cons(item, result);
  867.   }
  868.   return result;
  869. }
  870.  
  871.  
  872. /*
  873.  * When fetching resources we have to be told what kind of Scheme
  874.  * object to turn the value into.  The following is a table of type
  875.  * name symbols.
  876.  */
  877.  
  878. static SCM xt_make_boolean();
  879. static SCM xt_make_char();
  880. static SCM xt_make_integer();
  881. static SCM xt_make_short();
  882. static SCM xt_make_unsigned_char();
  883. static SCM xt_make_unsigned_short();
  884. static SCM xt_make_string();
  885. static SCM xt_make_widget();
  886. static SCM xt_make_widgetlist();
  887.  
  888. #ifdef MOTIF
  889. static SCM xt_make_xmstring();
  890. static SCM xt_make_xmstringtable();
  891. #endif
  892.  
  893. static struct {
  894.   char *name;
  895.   SCM sym;
  896.   SCM (*maker)();
  897. } type_table[] = {
  898.     {"xt:boolean",       0, xt_make_boolean},
  899.     {"xt:char",         0, xt_make_char},
  900.     {"xt:integer",       0, xt_make_integer},
  901.     {"xt:short",     0, xt_make_short},
  902.     {"xt:string",        0, xt_make_string},
  903.     {"xt:unsigned-char", 0, xt_make_unsigned_char},
  904.     {"xt:unsigned-short",0, xt_make_unsigned_short},
  905.     {"xt:widget",        0, xt_make_widget},
  906.     {"xt:widgetlist",    0, xt_make_widgetlist},
  907. #ifdef MOTIF
  908.     {"xt:xmstring",      0, xt_make_xmstring},
  909.     {"xt:xmstringtable", 0, xt_make_xmstringtable},
  910. #endif
  911. };
  912.  
  913. static void xt_init_resource_types()
  914. {
  915.   int i;
  916.   SCM s;
  917.  
  918.   for (i = 0; i < XtNumber(type_table); i++) {
  919.     s = sysintern(type_table[i].name, UNDEFINED);
  920.     type_table[i].sym = CAR(s);
  921.     CDR(s) = CAR(s);
  922.   }
  923. }
  924.  
  925. SCM xt_get_value(sw, sname, args)
  926. SCM sw, sname, args;
  927. {
  928.   SCM stype;
  929.   Arg arg[1];
  930.   XtArgVal value;
  931.   int i;
  932.  
  933.   ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xt_get_value);
  934.   ASSERT(NIMP(sname) && STRINGP(sname), sname, ARG2, s_xt_get_value);
  935.   ASSERT(NIMP(args) && CONSP(args), args, ARG3, s_xt_get_value);
  936.   stype = CAR(args);
  937.   ASSERT(NIMP(stype) && SYMBOLP(stype), stype, ARG3, s_xt_get_value);
  938.   args = CDR(args);
  939.   
  940.   XtSetArg(arg[0], CHARS(sname), &value);
  941.   value = 0;
  942.   XtGetValues(WIDGET(sw), arg, 1);
  943.  
  944.   for (i = 0; i < XtNumber(type_table); i++) {
  945.     if (stype == type_table[i].sym)
  946.       return type_table[i].maker(value, args);
  947.   }
  948.   return UNSPECIFIED;
  949. }
  950.  
  951. static SCM xt_make_char(value, args)
  952. XtArgVal value;
  953. SCM args;
  954. {
  955.   char *p = (char *) &value;
  956.   return MAKINUM((int) *p);
  957. }
  958.  
  959. static SCM xt_make_integer(value, args)
  960. XtArgVal value;
  961. SCM args;
  962. {
  963.   return MAKINUM((int) value);
  964. }
  965.  
  966. static SCM xt_make_short(value, args)
  967. XtArgVal value;
  968. SCM args;
  969. {
  970.   short *p = (short *) &value;
  971.   return MAKINUM(*p);
  972. }
  973.  
  974. static SCM xt_make_unsigned_char(value, args)
  975. XtArgVal value;
  976. SCM args;
  977. {
  978.   unsigned char *p = (unsigned char *) &value;
  979.   return MAKINUM((int) *p);
  980. }
  981.  
  982. static SCM xt_make_unsigned_short(value, args)
  983. XtArgVal value;
  984. SCM args;
  985. {
  986.   unsigned short *p = (unsigned short *) &value;
  987.   return MAKINUM((int) *p);
  988. }
  989.  
  990. static SCM xt_make_boolean(value, args)
  991. XtArgVal value;
  992. SCM args;
  993. {
  994.   if (value)
  995.     return BOOL_T;
  996.   else
  997.     return BOOL_F;
  998. }
  999.  
  1000. static SCM xt_make_string(value, args)
  1001. XtArgVal value;
  1002. SCM args;
  1003. {
  1004.   if (value == 0)
  1005.     return makstr(0);
  1006.   else
  1007.     return MAKFROMSTR((char *) value);
  1008. }
  1009.  
  1010. static SCM xt_make_widget(value, args)
  1011. XtArgVal value;
  1012. SCM args;
  1013. {
  1014.  if (value)
  1015.    return make_widget((Widget) value);
  1016.  else
  1017.    return BOOL_F;
  1018. }
  1019.  
  1020. static SCM xt_make_widgetlist(value, args)
  1021. XtArgVal value;
  1022. SCM args;
  1023. {
  1024.   SCM slen;
  1025.   SCM s;
  1026.   int i;
  1027.   SCM *dst;
  1028.   WidgetList src = (WidgetList) value;
  1029.  
  1030.   ASSERT(NIMP(args) && CONSP(args), args, ARG4, s_xt_get_value);
  1031.   slen = CAR(args);
  1032.   ASSERT(INUMP(slen), slen, ARG4, s_xt_get_value);
  1033.   s = make_vector(slen, UNDEFINED);
  1034.   dst = VELTS(s);
  1035.   for (i = 0; i < INUM(slen); i++)
  1036.     dst[i] = make_widget(src[i]);
  1037.   return s;
  1038. }
  1039.  
  1040. #ifdef MOTIF
  1041. static SCM xt_make_xmstring(value, args)
  1042. XtArgVal value;
  1043. SCM args;
  1044. {
  1045.   SCM s;
  1046.   s = make_xmstring();
  1047.   if (value == 0) {
  1048.     SETCDR(s, XmStringCreate("", XmSTRING_DEFAULT_CHARSET));
  1049.     return s;
  1050.   }
  1051.   SETCDR(s, (char *) XmStringCopy((XmString) value));
  1052.   return s;
  1053. }
  1054.  
  1055. static SCM xt_make_xmstringtable(value, args)
  1056. XtArgVal value;
  1057. SCM args;
  1058. {
  1059.   SCM slen;
  1060.   SCM s;
  1061.   int i;
  1062.   XmStringTable dst;
  1063.   XmStringTable src = (XmStringTable) value;
  1064.  
  1065.   ASSERT(NIMP(args) && CONSP(args), args, ARG4, s_xt_get_value);
  1066.   slen = CAR(args);
  1067.   ASSERT(INUMP(slen), slen, ARG4, s_xt_get_value);
  1068.   s = make_xmstringtable(INUM(slen));
  1069.   dst = (XmString *) CDR(s);
  1070.   for (i = 0; i < INUM(slen); i++)
  1071.     dst[i] = XmStringCopy(src[i]);
  1072.   return s;
  1073. }
  1074. #endif /* MOTIF */
  1075.  
  1076.  
  1077. SCM xt_next_event()
  1078. {
  1079.   XEvent e;
  1080.  
  1081.   XtNextEvent(&e);
  1082.   return make_xevent(&e);
  1083. }
  1084.  
  1085.  
  1086. SCM xt_set_sensitive(sw, ss)
  1087. SCM sw, ss;
  1088. {
  1089.   ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xt_set_sensitive);
  1090.   ASSERT(ss == BOOL_F || ss == BOOL_T, ss, ARG2, s_xt_set_sensitive);
  1091.   XtSetSensitive(WIDGET(sw), ss == BOOL_F ? FALSE : TRUE);
  1092.   return UNSPECIFIED;
  1093. }
  1094.  
  1095.  
  1096. SCM xt_set_values(args)
  1097. SCM args;
  1098. {
  1099.   SCM sw;
  1100.   ArgList arglist;
  1101.   int n;
  1102.  
  1103.   ASSERT(NIMP(args) && CONSP(args), args, ARG1, s_xt_set_values);
  1104.   sw = CAR(args); args = CDR(args);
  1105.   ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xt_set_values);
  1106.   ASSERT(NIMP(args), args, ARG2, s_xt_set_values);
  1107.   xt__make_arglist(args, &arglist, &n, s_xt_set_values);
  1108.   if (n) {
  1109.     XtSetValues(WIDGET(sw), arglist, n);
  1110.   }
  1111.  
  1112.   return UNSPECIFIED;
  1113. }
  1114.  
  1115.  
  1116. static int print_widget_class(exp, f, writing)
  1117. SCM exp;
  1118. FILE *f;
  1119. int writing;
  1120. {
  1121. #if 0
  1122.   lputs("#<widget class ",f);
  1123.   lputs(WIDGETCLASS(exp)->core_class.class_name,f);
  1124.   lputc('>',f);
  1125. #else
  1126.   SCM s;
  1127.   s = assoc(exp, *loc_class_map);
  1128.   if (s == BOOL_F || IMP(s) || NCONSP(s))
  1129.     lputs("#<unknown or invalid widget class>", f);
  1130.   else {
  1131.     lputs("#.(begin \"widget class\" ", f);
  1132.     iprin1(CDR(s), f, writing);
  1133.     lputc(')', f);
  1134.   }
  1135. #endif
  1136.   return 1;
  1137. }
  1138.  
  1139. static int print_widget(exp, f, writing)
  1140. SCM exp;
  1141. FILE *f;
  1142. int writing;
  1143. {
  1144.   lputs("#<",f);
  1145.   lputs(XtClass(WIDGET(exp))->core_class.class_name,f);
  1146.   lputs(" widget",f);
  1147.   if (XtIsSubclass(WIDGET(exp), coreWidgetClass)) {
  1148.     lputs(" \"",f);
  1149.     lputs(WIDGET(exp)->core.name,f);
  1150.     lputc('"',f);
  1151.   }
  1152.   lputs(" #x",f);
  1153.   intprint((long) WIDGET(exp),16,f);
  1154.   if (XtIsRealized(WIDGET(exp)))
  1155.     lputs(", is realized",f);
  1156.   if (XtIsManaged(WIDGET(exp)))
  1157.     lputs(", is managed",f);
  1158.   lputc('>',f);
  1159.   return 1;
  1160. }
  1161.  
  1162.  
  1163. void xt_init_widget_classes(table, count, list_name)
  1164. xt_widget_class_t table[];
  1165. int count;
  1166. char *list_name;
  1167. {
  1168.   int i;
  1169.   SCM s;
  1170.   SCM class;
  1171.   SCM class_list;
  1172.  
  1173.   class_list = EOL;
  1174.   for (i = 0; i < count; i++) {
  1175.     class = make_widget_class(*(table[i].wc_class));
  1176.     s = sysintern(table[i].wc_name, class);
  1177.     class_list = cons(class, class_list);
  1178.     *loc_class_map = cons(cons(CDR(s), CAR(s)), *loc_class_map);
  1179.   }
  1180.   s = sysintern(list_name, class_list);
  1181. }
  1182.  
  1183.  
  1184. iproc xt_lsubr2s[] = {
  1185.   {s_xt_add_callback,        xt_add_callback},
  1186.   {s_xt_add_event_handler,    xt_add_event_handler},
  1187.   {s_xt_app_create_shell,    xt_app_create_shell},
  1188.   {s_xt_create_managed_widget,    xt_create_managed_widget},
  1189.   {s_xt_create_popup_shell,    xt_create_popup_shell},
  1190.   {s_xt_create_widget,        xt_create_widget},
  1191.   {s_xt_get_value,        xt_get_value},
  1192.   {s_xt_initialize,        xt_initialize},
  1193.   {s_xt_remove_event_handler,    xt_remove_event_handler},
  1194.   {0, 0}
  1195. };
  1196.  
  1197. iproc xt_lsubrs[] = {
  1198.   {s_xt_main_loop,        xt_main_loop},
  1199.   {s_xt_manage_children,    xt_manage_children},
  1200.   {s_xt_set_values,        xt_set_values},
  1201.   {s_xt_unmanage_children,    xt_unmanage_children},
  1202.   {0, 0}
  1203. };
  1204.  
  1205. iproc xt_subr3s[] = {
  1206.   {s_xt_move_widget,        xt_move_widget},
  1207.   {0, 0}
  1208. };
  1209.  
  1210. iproc xt_subr2s[] = {
  1211.   {s_xt_add_time_out,        xt_add_time_out},
  1212.   {s_xt_class_subclassp,    xt_class_subclassp},
  1213.   {s_xt_popup,            xt_popup},
  1214.   {s_xt_set_sensitive,        xt_set_sensitive},
  1215.   {s_xt_subclassp,        xt_subclassp},
  1216.   {0, 0}
  1217. };
  1218.  
  1219. iproc xt_subr1s[] = {
  1220.   {s_xt_add_work_proc,        xt_add_work_proc},
  1221.   {s_xt_class,            xt_class},
  1222.   {s_xt_class_name,        xt_class_name},
  1223.   {s_xt_class_superclass,    xt_class_superclass},
  1224.   {s_xt_destroy_widget,        xt_destroy_widget},
  1225.   {s_xt_dispatch_event,        xt_dispatch_event},
  1226.   {s_xt_display,        xt_display},
  1227.   {s_xt_get_constraint_resource_li, xt_get_constraint_resource_list},
  1228.   {s_xt_get_resource_list,    xt_get_resource_list},
  1229.   {s_xt_is_realized,        xt_is_realized},
  1230.   {s_xt_map_widget,        xt_map_widget},
  1231.   {s_xt_name,            xt_name},
  1232.   {s_xt_parent,            xt_parent},
  1233.   {s_xt_popdown,        xt_popdown},
  1234.   {s_xt_realize_widget,        xt_realize_widget},
  1235.   {s_xt_remove_time_out,    xt_remove_time_out},
  1236.   {s_xt_remove_work_proc,    xt_remove_work_proc},
  1237.   {s_xt_superclass,        xt_superclass},
  1238.   {s_xt_unmap_widget,        xt_unmap_widget},
  1239.   {s_xt_unrealize_widget,    xt_unrealize_widget},
  1240.   {s_xt_window,            xt_window},
  1241.   {0, 0}
  1242. };
  1243.  
  1244. iproc xt_subr0s[] = {
  1245.   {s_xt_next_event,        xt_next_event},
  1246.   {0, 0}
  1247. };
  1248.  
  1249. #undef XX
  1250. #define XX(name, mark, free, equalp) TOKEN_PASTE(tc16_,name) = newsmob(&TOKEN_PASTE(smob,name));
  1251.  
  1252. void init_xt()
  1253. {
  1254.   loc_callbacks = &CDR(sysintern("*xt-callbacks*", EOL));
  1255.   loc_class_map = &CDR(sysintern(s_xt_widget_class_map, EOL));
  1256.   init_iprocs(xt_lsubr2s, tc7_lsubr_2);
  1257.   init_iprocs(xt_lsubrs, tc7_lsubr);
  1258.   init_iprocs(xt_subr3s, tc7_subr_3);
  1259.   init_iprocs(xt_subr2s, tc7_subr_2);
  1260.   init_iprocs(xt_subr1s, tc7_subr_1);
  1261.   init_iprocs(xt_subr0s, tc7_subr_0);
  1262.   XT_SMOBS
  1263.   xt_init_resource_types();
  1264.   xt_init_widget_classes(
  1265.     xt_widget_classes,
  1266.     XtNumber(xt_widget_classes),
  1267.     "*xt-widget-classes*");
  1268. }
  1269.